home *** CD-ROM | disk | FTP | other *** search
/ C/C++ Users Group Library 1996 July / C-C++ Users Group Library July 1996.iso / listings / v_02_07 / 2n07019a < prev    next >
Encoding:
Text File  |  1991-06-02  |  5.1 KB  |  194 lines
  1.  
  2. { Multi-timer demo package.  }
  3.  
  4.  
  5. program MultiDemo;
  6.  
  7. {
  8. The following resource is supplied with the examples that
  9. come with TPW.
  10. }
  11. {$R MDIAPP.RES}
  12.  
  13. uses WObjects, WinTypes, WinProcs, Strings, StdDlgs, Timers;
  14.  
  15.  
  16. type
  17.     TimerMDIWin = object(TMDIWindow)
  18.         TimerNumber    : integer;
  19.         function InitChild : PWindowsObject; virtual;
  20.         function CreateChild : PWindowsObject; virtual;
  21.         constructor Init(ATitle: PChar; AMenu: HMenu);
  22.         procedure WMSize(var Msg:TMessage); virtual wm_First + wm_Size;
  23.     private
  24.         function GetTimer : integer;
  25.     end;
  26.  
  27.     PTimerMDIWin = ^TimerMDIWin;
  28.  
  29.     TimerWin     = object(TWindow)
  30.         TotalEvents    : Longint;
  31.         EventInterval  : Longint;
  32.         LastEvent      : Longint;
  33.         WinTimer           : PWindowTimer;
  34.         constructor Init(AParent:PWindowsObject; Title:PChar;
  35.                          Interval:Longint);
  36.         Destructor Done; virtual;
  37.         procedure SetupWindow; virtual;
  38.         procedure WMTimer(var Msg:TMessage); virtual wm_First + wm_Timer;
  39.     procedure Paint(PaintDC : HDC; var PaintInfo:TPaintStruct); virtual;
  40.     procedure UpdateTitle;
  41.     end;
  42.     PTimerWin  = ^TimerWin;
  43.  
  44.   { Define a TApplication descendant }
  45.   TMDIApp = object(TApplication)
  46.     procedure InitMainWindow; virtual;
  47.     end;
  48.  
  49. constructor TimerWin.Init(AParent:PWindowsObject; Title:PChar;
  50.                           Interval:Longint);
  51. begin
  52.     TWindow.Init(AParent, Title);
  53.     EventInterval       := Interval;
  54.     TotalEvents         := 0;
  55. end;
  56.  
  57. destructor TimerWin.Done;
  58. var
  59.         p :     PTimerMDIWin;
  60. begin
  61.         if WinTimer <> NIL then
  62.         Dispose(WinTimer, Done);
  63.     UpdateTitle;
  64.     TWindow.Done;
  65.     p   := PTimerMDIWin(Parent);
  66.     p^.TileChildren;
  67. end;
  68.  
  69. procedure       TimerWin.UpdateTitle;
  70. var
  71.     Sbuf        : string[128];
  72.     Wbuf        : array [0..127] of char;
  73. begin
  74.     Str(TimerGetInterval, Sbuf);
  75.     Sbuf        := 'Timer Demo (interval == '+Sbuf+')';
  76.     StrPCopy(Wbuf, Sbuf);
  77.         SetWindowText(Parent^.HWindow, Wbuf);
  78. end;
  79.  
  80. procedure       TimerWin.SetupWindow;
  81. begin
  82.     WinTimer    := New(PWindowTimer, Init(@Self));
  83.     WinTimer^.Start(EventInterval);
  84.     UpdateTitle;
  85. end;
  86.  
  87. procedure       TimerWin.WMTimer(var Msg:TMessage);
  88. var
  89.         Rect : Trect;
  90. begin
  91.         Rect.left       := 0;
  92.     Rect.right  := 100;
  93.     Rect.Top    := 0;
  94.     Rect.Bottom := 100;
  95.         InvalidateRect(HWindow, @Rect, TRUE);
  96.         PostMessage(HWindow, wm_Paint, 0, 0);
  97.     TotalEvents := TotalEvents+1;
  98. end;
  99.  
  100. procedure TimerWin.Paint(PaintDC : HDC; var PaintInfo:TPaintStruct);
  101. var
  102.         TextDC  : HDC;
  103.     Sbuf        : string[128];
  104.     Wbuf        : array [0..127] of char;
  105. begin
  106.     TextDC      := PaintDC;
  107.         Str(GetTickCount, Sbuf);
  108.     Sbuf        := 'Time '+Sbuf;
  109.     StrPCopy(Wbuf, Sbuf);
  110.     TextOut(TextDC, 0, 0, WBuf, Length(Sbuf));
  111.     Str(TotalEvents, Sbuf);
  112.     Sbuf        := 'Count '+Sbuf;
  113.     StrPCopy(Wbuf, Sbuf);
  114.     TextOut(TextDC, 0, 15, WBuf, Length(Sbuf));
  115. end;
  116.  
  117. constructor TimerMDIWin.Init(ATitle: PChar; AMenu: HMenu);
  118. begin
  119.     TMDIWindow.Init(ATitle, AMenu);
  120.     TimerNumber := 0;
  121. end;
  122. function TimerMDIWin.CreateChild: PWindowsObject;
  123. begin
  124.         CreateChild     := TMDIWindow.CreateChild;
  125.     TileChildren;
  126.  
  127. end;
  128. procedure TimerMDIWin.WMSize(var Msg:TMessage);
  129. begin
  130.         TMDIWindow.WMSize(Msg);
  131.         TileChildren;
  132. end;
  133. function TimerMDIWin.InitChild: PWindowsObject;
  134. var
  135.     Name    : array [0..63] of char;
  136.     Temp    : string[64];
  137.     Text    : array[0..79] of char;
  138.     Sbuf        : string[128];
  139.     Units       : string[10];
  140.     Interval, PrintInterval     : Longint;
  141.     Code        : integer;
  142. begin
  143.         Text[0]  := #0;
  144.     StrCopy(Text, '5000');
  145.         if Application^.ExecDialog(New(PInputDialog, Init(@Self,
  146.         'Timer Demo', 'Enter timer interval',
  147.         Text, SizeOf(Text)))) = id_OK then
  148.         begin
  149.                 StrPas(Text);
  150.         Sbuf    := Text;
  151.             Val(Text, Interval, Code);
  152.         Str(GetTimer, Temp);
  153.             PrintInterval       := Interval;
  154.         if (PrintInterval mod 1000) = 0 then
  155.                 begin
  156.             Units                       := 's';
  157.                 PrintInterval   := PrintInterval div 1000;
  158.             end
  159.             else
  160.                 Units                   := 'ms';
  161.             Str(PrintInterval,Sbuf);
  162.             Temp      := '#'+Temp+' ['+Sbuf+Units+']';
  163.         StrPCopy(Name, Temp);
  164.             InitChild := New(PTimerWin, Init(@Self, Name, Interval));
  165.         end
  166.     else
  167.         InitChild  := NIL;
  168. end;
  169.  
  170. function TimerMDIWin.GetTimer : integer;
  171. begin
  172.         TimerNumber     := TimerNumber+1;
  173.     GetTimer    := TimerNumber;
  174. end;
  175.  
  176. { Construct the THelloApp's MainWindow object, loading its menu }
  177. procedure TMDIApp.InitMainWindow;
  178. begin
  179.   MainWindow  := New(PTimerMDIWin, Init('Multi-timer demo',
  180.     LoadMenu(HInstance, 'MDIMenu')));
  181. end;
  182.  
  183. { Declare a variable of type TMDIApp}
  184. var
  185.   MDIApp: TMDIApp;
  186.   x    : longint;
  187.  
  188. { Run the MDIApp }
  189. begin
  190.   MDIApp.Init('MDIApp');
  191.   MDIApp.Run;
  192.   MDIApp.Done;
  193. end.
  194.